home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / vpi1manl.zip / CHARITY.ZIP / ENTRY.PRG < prev    next >
Text File  |  1991-12-29  |  4KB  |  112 lines
  1. ***************************************************************************
  2. **  ENTRY.PRG
  3. **  (C) Copyright 1990, Sub Rosa Publishing Inc.
  4. **  A demonstration program provided to VP-Info users.
  5. **  This program may be copied freely. If it is used in commercial code,
  6. **  please credit the source, Sub Rosa Publishing Inc.
  7. **
  8. **  ENTRY is a free-standing program chained to from DONMENU.PRG, used to
  9. **  enter and edit donations.
  10. **
  11. **  ENTRY is compatible with all current versions of VP-Info.
  12. **
  13. **  Sid Bursten and Bernie Melman
  14. **  May 9,1990
  15. ***************************************************************************
  16. ON escape                    ;what to do when <Esc> is pressed
  17.    WINDOW
  18.    CANCEL
  19. ENDON
  20. SET text on                ;include display fields in GET TABLE for READ
  21. SET trim off               ;do not trim & macros in TEXT display
  22. SET execution off          ;don't force re-execution of ON FIELD on exit
  23. SET deleted on             ;don't show deleted records
  24. SET talk off               ;suppress messages like NO FIND
  25. USE donate index donatdon,donatsol,donatdat
  26. USE#2 donor index don_code
  27. USE#3 solicit index sol_code
  28. IF recno(1)=0
  29.    APPEND blank
  30. ENDIF
  31. goto dbf(recs)               ;goto last record added to file
  32. PERFORM inputscrn
  33. DO WHILE t
  34.    :field=field(donor)            ;start with first name
  35.    IF donor<>donor#2
  36.       FIND#2 &donor#1  ;align file when donor code filled in
  37.       REPLACE solicitor with solicitor#2
  38.    ENDIF
  39.    IF solicitor<>solicitor#3      ;align solicitor file
  40.       FIND#3 solicitor#1
  41.    ENDIF
  42.    @ 0,0 say pic(#,'999,999')
  43.    @ 0,77 say iff(deleted(1),'DEL','   ')
  44.    READ
  45.    kn=:key                        ;save key used to get out of READ
  46.    DO CASE kn
  47.    CASE kn=17                     ; ^Q=no update
  48.       NOUPDATE                    ;cancel any changes already made
  49.    CASE kn=329                    ; <PgUp>=Beginning of file
  50.       SKIP -1
  51.       IF #=0                      ;don't back up past beginning of file
  52.          GOTO top
  53.          RING                     ;notify user end of file reached
  54.       ENDIF
  55.    CASE kn=337                    ; <PgDn>=End of file
  56.       SKIP
  57.       IF eof
  58.          GOTO bottom
  59.          RING                     ;notify user end of file reached
  60.       ENDIF
  61.    CASE kn=375                    ; ^<Home>=Beginning of file
  62.       GO top
  63.    CASE kn=373                    ; ^<End>=End of file
  64.       GOTO bottom
  65.    CASE kn=374                    ; ^<PgDn>=Add a record
  66.       GOTO top
  67.       IF donor>' '
  68.          APPEND blank             ;append only if not already an empty record
  69.          REPLACE date with date(ymd)
  70.       ENDIF
  71.    CASE kn=335                    ; <End>=Quit
  72.       BREAK
  73.    ENDCASE kn
  74. ENDDO
  75. CHAIN DONMENU
  76. *
  77. PROCEDURE inputscrn
  78.    WINDOW               ;cancel any existing window before erasing screen
  79.    ERASE
  80.    SET width to 80
  81.    TEXT .3              ;get screen text from library, volume number 3
  82.    ON field
  83.    FIELD donor
  84.       IF @(' ',donor)>0
  85.          :field=field(donor)
  86.       ELSE
  87.          IF donor<>donor#2
  88.             FIND#2 &donor#1  ;align file when donor code filled in
  89.             IF recno(2)>0
  90.                IF solicitor<>solicitor#3
  91.                   FIND#3 &solicitor#1  ;align file when solicitor code filled in
  92.                ENDIF
  93.                REPLACE solicitor with solicitor#3
  94.                @ 23,0
  95.             ELSE
  96.                @ 23,0 say cen('Invalid Donor number...please re-enter.',80)
  97.             ENDIF
  98.          ENDIF
  99.       ENDIF
  100.    FIELD date
  101.       IF date=' ' .or. date<>date(ymd,date)
  102.          :field=field(date)
  103.          @ 23,0 say cen('Date must be filled in with legal date in form YY/MM/DD',80)
  104.          RING
  105.       ELSE
  106.          @ 23,0
  107.       ENDIF
  108.    ENDON
  109. ENDPROC inputscrn
  110. *
  111. *                     *** end of program ENTRY.prg ***
  112.